home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Just Call Me Internet
/
Just Call Me Internet.iso
/
prog
/
atari
/
m2
/
cat3src
/
cat
/
treelist.i
< prev
next >
Wrap
Text File
|
1997-10-26
|
67KB
|
2,031 lines
IMPLEMENTATION MODULE treeList;
(*==============================================================*
* Modul: CAT-Anzeigemodul fr Stichwortlisten *
* Autor: Dirk Steins *
* erstellt am: 8.8.1993 *
* letzte nderung am: 10.08.1993 *
* Version: 0.0 *
*==============================================================*
*----------------------------------------------------------------------------
* Datum Vers. Autor nderung (Arbeitsbericht)
*----------------------------------------------------------------------------
* 08.08.93 0.0 DS Erste Implementation erstellt
* 14.08.93 0.1 DS Modul zeigt Bume richtig an und funktioniert erstmal
* 06.06.95 0.2 DS Fehler mit berlappungen unter gewissen Umstnden
* gefunden und behoben
*
*----------------------------------------------------------------------------
*)
(*-- MM2-Module ------------------------------------------------------------*)
FROM SYSTEM IMPORT ADDRESS, ADR, TSIZE, CALLSYS, CADR;
FROM Storage IMPORT ALLOCATE, DEALLOCATE;
IMPORT Block;
IMPORT Lists;
IMPORT GrafBase;
IMPORT BinOps;
IMPORT Strings;
IMPORT StrConv;
IMPORT MOSGlobals;
IMPORT Keyboard;
FROM Keyboard IMPORT SpecialCode;
(*-- Cat-Module ------------------------------------------------------------*)
FROM Void IMPORT v;
IMPORT data;
IMPORT dataSys;
IMPORT EditTypes;
IMPORT MTE;
IMPORT VDIStandards;
IMPORT MausTauschrsc;
IMPORT CatTypes;
IMPORT handlePool;
IMPORT ConfVars;
IMPORT WdwManager;
IMPORT RectFuncs;
IMPORT FontSelect;
IMPORT CatGlobal;
IMPORT grin;
IMPORT Varnames;
IMPORT GroupSelect;
(*-- Magic-Lib -------------------------------------------------------------*)
IMPORT MagicStrings;
IMPORT MagicAES;
IMPORT MagicVDI;
IMPORT MagicFSM;
IMPORT MagicDOS;
IMPORT MagicConvert;
(*-- Magic-Tools -----------------------------------------------------------*)
IMPORT mtAppl;
IMPORT mtArea;
IMPORT mtUtils;
IMPORT mtAlerts;
IMPORT mtDials;
IMPORT mtPopups;
(*-- Konstanten ------------------------------------------------------------*)
CONST cElemLines = 2;
cElemHDist = 8;
cElemWDist = 32;
cMinX = 8;
cMinY = 8;
(*-- Typdefinitionen -------------------------------------------------------*)
TYPE zoomModeType = (zmNormal, zmZoom);
TYPE tLine = RECORD
p1, p2 : GrafBase.Point;
END;
tLongLine = RECORD
p1, p2 : GrafBase.LongPnt;
END;
tShortText = ARRAY [0..19] OF CHAR;
treeElemPtr = POINTER TO treeElem;
treeElem = RECORD
msgNum : CARDINAL;
selected: BOOLEAN;
width : INTEGER;
area : GrafBase.LongRect;
flags : BITSET; (* Die Bits der Nachricht *)
name,
betreff : tShortText;
up,
down,
left,
right : CARDINAL; (* Indizes in treeArray *)
END;
treeArrayType = ARRAY [0..$FFFF] OF treeElem;
treeArrayPtr = POINTER TO treeArrayType;
treeOffsetArray = ARRAY [0..$FFFFFFFF] OF LONGINT;
treeOffsetArrayPtr = POINTER TO treeOffsetArray;
treeOffsetType = RECORD
size : LONGINT;
array: treeOffsetArrayPtr;
END;
treeOffsetPtr = POINTER TO treeOffsetType;
treeBuildType = (tVertical, tHorizontal);
treeWindow = RECORD
wdw : INTEGER; (* Windowhandle *)
vdi : INTEGER; (* VDI-Handle *)
grinWindow : INTEGER; (* Das zugehrige Anzeigefenster *)
butWork, (* Rechteck des Objektbaumes *)
treeWork : GrafBase.Rectangle; (* Workrectangle des Fensters *)
number : INTEGER; (* Nummer des Fensters im Modul *)
font,
fontSize : INTEGER; (* Font & Gre *)
document : GrafBase.LongRect;
grHandle : handlePool.oneHandlePtr; (* Gruppenhandle *)
grName : ARRAY [0..255] OF CHAR; (* Gruppenname fr Titelzeile *)
charHeight, (* Zeichensatzvariablen *)
charWidth : INTEGER;
isFSM : BOOLEAN;
treeType : treeBuildType;
zoomMode : zoomModeType;
(* Jetzt die Daten fr den Baum *)
elemHeight,
elemDist,
elemWDist, (* Gren und Abstnde der einzelnen Objekte *)
elemHDist : INTEGER; (* Gren und Abstnde der einzelnen Objekte *)
treeElems : CARDINAL;
tree : treeArrayPtr;
vertical : treeOffsetPtr;
horizontal : treeOffsetPtr;
END;
treeWdwPtr = POINTER TO treeWindow;
(*-- Globale Variablen -----------------------------------------------------*)
VAR windows : Lists.List;
maxUpLevels : INTEGER;
maxTreeDepth : INTEGER;
notReadEff : BITSET;
(*-------------- Suchfunktionen in Liste -----------------------*)
TYPE intPtr = POINTER TO INTEGER;
cardPtr = POINTER TO CARDINAL;
(*$A+,Z-*)
PROCEDURE FindWinCond(e, i : ADDRESS):BOOLEAN;
(* Abbruchprozedur, wie in <Lists> gefordert *)
BEGIN
RETURN treeWdwPtr(e)^.wdw = intPtr(i)^
END FindWinCond;
PROCEDURE FindGroupCond (e, i : ADDRESS): BOOLEAN;
BEGIN
RETURN treeWdwPtr(e)^.grHandle^.group = cardPtr(i)^
END FindGroupCond;
(*$A=,Z=*)
TYPE NumSet = SET OF [0..255];
VAR treeNums : NumSet;
globalNumber : INTEGER;
PROCEDURE FindNum () : INTEGER;
VAR i : INTEGER;
BEGIN
IF (globalNumber >= 0) &
~ (globalNumber IN treeNums)
THEN
INCL (treeNums, globalNumber);
i := globalNumber;
globalNumber := -1;
RETURN i
END;
FOR i := 0 TO 255 DO
IF ~(i IN treeNums) THEN INCL (treeNums, i); RETURN i; END;
END;
END FindNum;
PROCEDURE ClearNum (num : INTEGER);
BEGIN
EXCL (treeNums, num);
END ClearNum;
(*-- Baum positionieren ------------------------------------------------*)
(*-- Subfunktionen, die dynamische Array verwalten ---------------------*)
PROCEDURE createOffset (size: LONGINT): treeOffsetPtr;
VAR offset: treeOffsetPtr;
BEGIN
ALLOCATE (offset, TSIZE (treeOffsetType));
IF offset = NIL THEN RETURN NIL END;
offset^.size := size;
ALLOCATE (offset^.array, size * TSIZE (LONGINT));
Block.Clear (offset^.array, size * TSIZE (LONGINT));
IF offset^.array = NIL THEN DEALLOCATE (offset, 0); RETURN NIL END;
RETURN offset;
END createOffset;
PROCEDURE freeOffset (offset: treeOffsetPtr);
BEGIN
DEALLOCATE (offset^.array, 0);
DEALLOCATE (offset, 0);
END freeOffset;
PROCEDURE resetOffset (offset: treeOffsetPtr);
VAR i : LONGINT;
BEGIN
WITH offset^ DO
FOR i := 0 TO offset^.size - 1 DO
array^[i] := cMinY;
END;
END;
END resetOffset;
PROCEDURE currentPosition (offset: treeOffsetPtr; position: LONGINT): LONGINT;
BEGIN
IF position >= offset^.size THEN RETURN 0 END;
RETURN offset^.array^[position];
END currentPosition;
PROCEDURE setCurrentPosition (offset: treeOffsetPtr; index: LONGINT; value: LONGINT);
VAR newArray : treeOffsetArrayPtr;
newSize : LONGINT;
BEGIN
IF (index >= offset^.size)
THEN
(* Realloc, Array vergrern *)
newSize := index + index DIV 2;
ALLOCATE (newArray, newSize * TSIZE (LONGINT));
IF newArray = NIL THEN RETURN END;
Block.Clear (newArray, newSize * TSIZE (LONGINT));
Block.Copy (offset^.array, offset^.size * TSIZE (LONGINT), newArray);
DEALLOCATE (offset^.array, 0);
offset^.size := newSize;
offset^.array := newArray;
END;
offset^.array^[index] := value;
END setCurrentPosition;
PROCEDURE sumOfPositions (offset: treeOffsetPtr; index: LONGINT): LONGINT;
VAR sum : LONGINT;
i : LONGINT;
stop : LONGINT;
BEGIN
sum := 0;
WITH offset^ DO
IF index > size
THEN
stop := size
ELSE
stop := index;
END;
FOR i := 0 TO stop - 1 DO
INC (sum, array^[i]);
END;
END;
RETURN sum;
END sumOfPositions;
(* Routinen fr Verticalen (links nach rechts) Baum *)
(*-- Horizontale Position setzen ---------------------------------------*)
PROCEDURE setPositionsVertical (ptr: treeWdwPtr; idx: CARDINAL; level: LONGINT;
VAR maxWidth, maxHeight : LONGINT);
BEGIN
WITH ptr^ DO
(* Addiere die Summe aller Breiten der Knoten bis zu dieser Tiefe und
* benutze es als x-Position
*)
WITH tree^[idx].area DO
x := (level * LONG(elemHDist)) + sumOfPositions (horizontal, level) + cMinX;
w := currentPosition (horizontal, level);
(* Jetzt maxHeight und maxWidth prfen
*)
maxWidth := BinOps.HigherLInt (maxWidth, x + w);
maxHeight := BinOps.HigherLInt (maxHeight, y + h);
END;
(* Jetzt werden die Koordinaten von allen subTrees gesetzt *)
idx := tree^[idx].down;
WHILE idx < dataSys.notSaved DO
setPositionsVertical (ptr, idx, level+1, maxWidth, maxHeight);
idx := tree^[idx].right;
END;
END; (* WITH ptr^ DO *)
END setPositionsVertical;
(*-- Subtree nach unten verschieben ------------------------------------*)
PROCEDURE shiftSubtreeVertical (ptr: treeWdwPtr; idx: CARDINAL; dif: LONGINT);
VAR i : CARDINAL;
BEGIN
WITH ptr^ DO
INC (tree^[idx].area.y, dif);
i := tree^[idx].down;
WHILE i < dataSys.notSaved DO
shiftSubtreeVertical (ptr, i, dif);
i := tree^[i].right;
END;
END;
END shiftSubtreeVertical;
(*-- Einen Node positionieren ------------------------------------------*)
PROCEDURE computePositionsVertical (ptr: treeWdwPtr; idx: CARDINAL; level: LONGINT): LONGINT;
VAR currentHpos,
currentVpos : LONGINT;
firstKid,
lastKid : CARDINAL;
i : CARDINAL;
j : LONGINT;
depth : LONGINT;
offset : LONGINT;
pos : LONGINT;
top,
bottom : LONGINT;
BEGIN
WITH ptr^ DO
depth := 0;
(* Get the current positions for this level *)
currentHpos := currentPosition (horizontal, level);
currentVpos := currentPosition (vertical, level);
(* set the current horizontal width to the max widths of all
* elements at this level
*)
setCurrentPosition (horizontal, level, BinOps.HigherLInt (currentHpos, tree^[idx].area.w));
IF tree^[idx].down >= dataSys.notSaved
THEN
tree^[idx].area.y := currentVpos;
ELSE
(* if the node has subnodes, recursively figure the positions of each
* subnode
*)
i := tree^[idx].down;
WHILE i < dataSys.notSaved DO
depth := BinOps.HigherLInt (computePositionsVertical (ptr, i, level+1), depth);
i := tree^[i].right;
END; (* WHILE *)
(* now that the vertical positions of all children are
* known, find the vertical extent of all subnodes
*)
i := tree^[idx].down;
firstKid := i;
WHILE i < dataSys.notSaved DO
lastKid := i;
i := tree^[i].right;
END;
(*
(* Top und Bottom berechnen *)
top := tree^[firstKid].area.y + tree^[firstKid].area.h DIV 2;
bottom := tree^[lastKid].area.y + tree^[lastKid].area.h DIV 2;
(* set the nodes position to the center of its subnodes
*)
tree^[idx].area.y := (top DIV 2) + (bottom DIV 2) - (elemHeight DIV 2);
*)
top := tree^[firstKid].area.y;
bottom := tree^[lastKid].area.y + tree^[lastKid].area.h - 1;
tree^[idx].area.y := (top + bottom - LONG(elemHeight-1)) DIV 2;
(* if this position is less than the next available
* position, correct it to be the next available
* position, calculate the amount by which all subnodes
* must be shifted, and shift the entire sub-tree.
*)
IF tree^[idx].area.y < currentVpos
THEN
offset := currentVpos - tree^[idx].area.y;
i := tree^[idx].down;
WHILE i < dataSys.notSaved DO
shiftSubtreeVertical (ptr, i, offset);
i := tree^[i].right;
END;
(* Adjust the next available space at all levels below
* the current level
*)
FOR j := level+1 TO depth DO
pos := currentPosition (vertical, j);
setCurrentPosition (vertical, j, pos+offset);
END (* FOR *);
(* set the nodes position
*)
tree^[idx].area.y := currentVpos;
END (* if *);
END; (* if hasSubnodes *)
(* Record the current vertical position at this level
*)
setCurrentPosition (vertical, level, tree^[idx].area.y + tree^[idx].area.h + LONG(elemDist));
RETURN BinOps.HigherLInt (depth, level);
END; (* WITH ptr^ DO *)
END computePositionsVertical;
(* Routinen fr Horizontalen (oben nach unten) Baum *)
(*-- Horizontale Position setzen ---------------------------------------*)
PROCEDURE setPositionsHorizontal (ptr: treeWdwPtr; idx: CARDINAL; level: LONGINT;
VAR maxWidth, maxHeight : LONGINT);
BEGIN
WITH ptr^ DO
(* Addiere die Summe aller Hhen der Knoten bis zu dieser Tiefe und
* benutze es als y-Position
*)
WITH tree^[idx].area DO
y := (level * LONG(elemHDist)) + sumOfPositions (vertical, level) + cMinY;
(* w := currentPosition (horizontal, level); *)
(* Jetzt maxHeight und maxWidth prfen
*)
maxWidth := BinOps.HigherLInt (maxWidth, x + w);
maxHeight := BinOps.HigherLInt (maxHeight, y + h);
END;
(* Jetzt werden die Koordinaten von allen subTrees gesetzt *)
idx := tree^[idx].down;
WHILE idx < dataSys.notSaved DO
setPositionsHorizontal (ptr, idx, level+1, maxWidth, maxHeight);
idx := tree^[idx].right;
END;
END; (* WITH ptr^ DO *)
END setPositionsHorizontal;
(*-- Subtree nach unten verschieben ------------------------------------*)
PROCEDURE shiftSubtreeHorizontal (ptr: treeWdwPtr; idx: CARDINAL; dif: LONGINT);
VAR i : CARDINAL;
BEGIN
WITH ptr^ DO
INC (tree^[idx].area.x, dif);
i := tree^[idx].down;
WHILE i < dataSys.notSaved DO
shiftSubtreeHorizontal (ptr, i, dif);
i := tree^[i].right;
END;
END;
END shiftSubtreeHorizontal;
(*-- Einen Node positionieren ------------------------------------------*)
PROCEDURE computePositionsHorizontal (ptr: treeWdwPtr; idx: CARDINAL; level: LONGINT): LONGINT;
VAR currentHpos,
currentVpos : LONGINT;
firstKid,
lastKid : CARDINAL;
i : CARDINAL;
j : LONGINT;
depth : LONGINT;
offset : LONGINT;
pos : LONGINT;
top,
bottom : LONGINT;
BEGIN
WITH ptr^ DO
depth := 0;
(* Get the current positions for this level *)
currentHpos := currentPosition (horizontal, level);
currentVpos := currentPosition (vertical, level);
(* set the current horizontal width to the max widths of all
* elements at this level
*)
setCurrentPosition (vertical, level, BinOps.HigherLInt (currentVpos, tree^[idx].area.h));
IF tree^[idx].down >= dataSys.notSaved
THEN
tree^[idx].area.x := currentHpos;
ELSE
(* if the node has subnodes, recursively figure the positions of each
* subnode
*)
i := tree^[idx].down;
WHILE i < dataSys.notSaved DO
depth := BinOps.HigherLInt (computePositionsHorizontal (ptr, i, level+1), depth);
i := tree^[i].right;
END; (* WHILE *)
(* now that the vertical positions of all children are
* known, find the vertical extent of all subnodes
*)
i := tree^[idx].down;
firstKid := i;
WHILE i < dataSys.notSaved DO
lastKid := i;
i := tree^[i].right;
END;
top := tree^[firstKid].area.x;
bottom := tree^[lastKid].area.x + tree^[lastKid].area.w - 1 ;
tree^[idx].area.x := (top + bottom - (tree^[idx].area.w - 1)) DIV 2;
(* if this position is less than the next available
* position, correct it to be the next available
* position, calculate the amount by which all subnodes
* must be shifted, and shift the entire sub-tree.
*)
IF tree^[idx].area.x < currentHpos
THEN
offset := currentHpos - tree^[idx].area.x;
i := tree^[idx].down;
WHILE i < dataSys.notSaved DO
shiftSubtreeHorizontal (ptr, i, offset);
i := tree^[i].right;
END;
(* Adjust the next available space at all levels below
* the current level
*)
FOR j := level+1 TO depth DO
pos := currentPosition (horizontal, j);
setCurrentPosition (horizontal, j, pos+offset);
END (* FOR *);
(* set the nodes position
*)
tree^[idx].area.x := currentHpos;
END (* if *);
END; (* if hasSubnodes *)
(* Record the current vertical position at this level
*)
setCurrentPosition (horizontal, level, tree^[idx].area.x + tree^[idx].area.w - 1 + LONG(elemDist));
RETURN BinOps.HigherLInt (depth, level);
END; (* WITH ptr^ DO *)
END computePositionsHorizontal;
(*-- den ganzen Baum positionieren -------------------------------------*)
PROCEDURE posTree (ptr: treeWdwPtr);
VAR maxWidth,
maxHeight : LONGINT;
i : CARDINAL;
extend : ARRAY [0..3] OF GrafBase.Point;
maxW,
w : INTEGER;
BEGIN
WITH ptr^ DO
(* Set elem height und minWidth
*)
CASE zoomMode OF
zmNormal: elemHeight := charHeight * cElemLines;
elemDist := charHeight * 2;
elemHDist := charWidth * cElemHDist; |
zmZoom : elemHeight := charHeight;
elemDist := charHeight * 2;
elemHDist := charWidth * 3;
ELSE
END;
maxHeight := 0;
maxWidth := 0;
maxW := 0;
(* set each nodes width and height
*)
IF (mtAppl.Bitplanes = 1)
THEN
IF (CatGlobal.treeTextCol > 0)
THEN
CatGlobal.treeBackCol := 0;
ELSE
IF CatGlobal.treeBackCol = 0 THEN CatGlobal.treeBackCol := 1 END;
END;
CatGlobal.treeLineCol := CatGlobal.treeTextCol;
CASE CatGlobal.treeUnreadEff OF
0 : notReadEff := {}; |
1 : notReadEff := {MagicVDI.Fat}; |
2 : notReadEff := {MagicVDI.Italic}; |
3 : notReadEff := {MagicVDI.Light}; |
ELSE
notReadEff := {};
END;
ELSE
notReadEff := {};
END;
IF mtAppl.Bitplanes = 1
THEN
(* Texteffect setzen *)
v.bset := MagicVDI.SetTexteffect (vdi, notReadEff);
END;
FOR i := 0 TO treeElems - 1 DO
IF zoomMode = zmNormal
THEN
VDIStandards.InqTextextend (isFSM, vdi, tree^[i].betreff, extend);
w := extend[1].x - extend[0].x;
VDIStandards.InqTextextend (isFSM, vdi, tree^[i].name, extend);
w := BinOps.HigherInt (w, extend[1].x - extend[0].x);
maxW := BinOps.HigherInt (w, maxW);
ELSE
w := charWidth;
END;
maxW := BinOps.HigherInt (w, maxW);
tree^[i].area.w := w;
tree^[i].area.h := elemHeight;
END;
IF mtAppl.Bitplanes = 1
THEN
(* Texteffect setzen *)
v.bset := MagicVDI.SetTexteffect (vdi, {});
END;
IF treeType = tHorizontal
THEN
FOR i := 0 TO treeElems - 1 DO
tree^[i].area.w := maxW;
END;
END;
(* Reset the auxiliary tables
*)
resetOffset (vertical);
resetOffset (horizontal);
IF treeType = tVertical
THEN
(* compute each node's x,y position
*)
v.lint := computePositionsVertical (ptr, 0, 0);
(* Jetzt noch die horizontalen Positionen setzen
*)
setPositionsVertical (ptr, 0, 0, maxWidth, maxHeight);
(* set document size
*)
ELSIF treeType = tHorizontal
THEN
(* compute each node's x,y position
*)
v.lint := computePositionsHorizontal (ptr, 0, 0);
(* Jetzt noch die horizontalen Positionen setzen
*)
setPositionsHorizontal (ptr, 0, 0, maxWidth, maxHeight);
(* set document size
*)
END;
document.w := maxWidth + LONG(charWidth) - 1;
document.h := maxHeight + LONG(charHeight) - 1;
END;
END posTree;
(* ---------------------- Font-Funktionen ----------------------- *)
PROCEDURE iTreeSetFont (wdw : INTEGER; fnt, fntSize : INTEGER; redraw: BOOLEAN);
(* Setzt den Font fr das Stichwortlistenfenster *)
VAR r : GrafBase.Rectangle;
ptr : treeWdwPtr;
varName : CatTypes.String255;
place : GrafBase.Rectangle;
i : CARDINAL;
maxWidth,
maxHeight : LONGINT;
BEGIN
IF handlePool.FindEntry (ADR(wdw), FindWinCond, windows, ptr)
THEN
WITH ptr^ DO
font := fnt;
fontSize := fntSize;
FontSelect.SetFont (vdi, font, fontSize, TRUE, v.bool, isFSM, charWidth, charHeight);
(* Jetzt ist der Font gesetzt. Jetzt noch Window snappen und dann neu
* zeichnen lassen
*)
Strings.Concat (cTreeFont, StrConv.IntToStr (number, 0), varName, v.bool);
v.bool := ConfVars.SetConfigInt (varName, font);
Strings.Concat (cTreeSize, StrConv.IntToStr (number, 0), varName, v.bool);
v.bool := ConfVars.SetConfigInt (varName, fontSize);
(* Jetzt habe ich einen Baum im Speicher, der mit Indizes arbeitet.
* Also knnen wir jetzt daran gehen, diese Objekte alle zu plazieren.
* Das geht am besten mit einer rekursiven Prozedur, die sowohl die Breite
* als auch die Hhe eines Eintrages zurckliefert
*)
posTree (ptr);
WdwManager.SetNewDocument (wdw, document, FALSE);
WdwManager.SetDocumentParms (wdw, 1, 1);
(* Damit die Scrollbereiche neu berechnet werden *)
WdwManager.GetWdwSize (wdw, r);
WdwManager.SetWdwSize (wdw, r);
IF redraw THEN
WdwManager.RedrawWdw (wdw, treeWork);
END;
END; (* WITH ed^ DO *)
END;
END iTreeSetFont;
(* Ich brauche Prozeduren, die folgende Funktionen erfllen:
*
* - schneidet eine Linie ein Rechteck? (Redraw)
* Dies lsen wir einfach ber Rcintersect. Ist zwar nicht 100%ig exakt,
* aber schneller. Und eine vollstndige berprfung wre langsamer als
* ein paar Linien zustzlich ber das VDI zeichnen zu lassen.
* - wo verlt eine Linie ein Rechteck ? (Linienzeichnen)
* Siehe GetIntersection
* - befindet sich ein Element in einem Rechteck (Rechteckberschneidung, Redraw)
* wird gelst ber RcIntersect (ClipRect)
* - Zeichnen eines Elementes und der Verbindungslinien von/zu diesem Element
*)
(*
PROCEDURE GetIntersection (VAR line : tLine; r: GrafBase.Rectangle);
(* Berechnet den Schnittpunkt einer Linie line (x,y) -> (w,h) mit
* einer der Seiten des Rechtecks r. Einer der beiden Endpunkte liegt dabei
* innerhalb des Rechtecks r.
* ACHTUNG: Diese Routine ist nicht allgemein einsetzbar, da sie erstens
* nur den Schnittpunkt mit der linken oder rechten Seite des Rechtecks (bzw.
* dessen Verlngerung!) berechnet, und zweitens mit berlappungen nicht
* zurechtkommt, d.h. ein Punkt mu mit den x-Koordinaten auerhalb des
* Rechtecks liegen. Fr den geplanten Zweck ist das aber vollkommen
* ausreichend und schneller!
*)
VAR po1, po2, po3 : GrafBase.Point;
BEGIN
(* Erstmal den Punkt herausfinden, der innerhalb des Rechtecks liegt *)
WITH line DO
IF RectFuncs.IsInRect (p1.x, p1.y, r)
THEN
po1 := p1;
po2 := p2;
ELSE
po1 := p2;
po2 := p1;
END;
END;
(* Jetzt herausfinden, ob wir die rechte oder linke Begrenzungslinie
* des Rechtecks nehmen. po2 ist der Punkt, der nicht im Rechteck liegt
*)
IF po2.x < r.x
THEN
(* Die linke Senkrechte des Rechtecks nehmen *)
po3.x := r.x;
ELSE
(* Die rechte Senkrechte des Rechtecks nehmen *)
po3.x := r.x + r.w - 1;
END;
IF po2.x = po1.x
THEN
po3.y := po2.y (* Linie ist eine Senkrechte *)
ELSE
IF po2.y > po1.y
THEN
po3.y := SHORT(INT((FLOAT(po2.y - po1.y) / FLOAT(po2.x - po1.x)) * FLOAT(po3.x - po2.x))) + po2.y;
ELSE
po3.y := SHORT(INT((FLOAT(po1.y - po2.y) / FLOAT(po1.x - po2.x)) * FLOAT(po3.x - po2.x))) + po2.y;
END;
END;
(* So, jetzt haben wir den neuen Punkt. Die Linie auerhalb geht jetzt
* von po3 nach po2
*)
WITH line DO
p1 := po3;
p2 := po2;
END;
END GetIntersection;
*)
PROCEDURE MidPointV (r : GrafBase.LongRect; right: BOOLEAN): GrafBase.LongPnt;
(* Berechnet den Mittelpunkt eines Rechtecks
*)
VAR p : GrafBase.LongPnt;
BEGIN
IF right
THEN
p.x := r.x + r.w + 3;
ELSE
p.x := r.x - 3;
END;
p.y := r.y + (r.h DIV 2);
RETURN p
END MidPointV;
PROCEDURE MidPointH (r : GrafBase.LongRect; down: BOOLEAN): GrafBase.LongPnt;
(* Berechnet den Mittelpunkt eines Rechtecks
*)
VAR p : GrafBase.LongPnt;
BEGIN
IF down
THEN
p.y := r.y + r.h + 3;
ELSE
p.y := r.y - 3;
END;
p.x := r.x + (r.w DIV 2);
RETURN p
END MidPointH;
PROCEDURE ClipLongRect (frame: GrafBase.LongRect; clip: GrafBase.LongRect): GrafBase.LongRect;
(* clippt das Rechteck frame auf das Rechteck clip
*)
BEGIN
WITH frame DO
IF x<clip.x THEN w:=w-clip.x+x; x:=clip.x END;
IF y<clip.y THEN h:=h-clip.y+y; y:=clip.y END;
IF (w<0) OR (h<0) THEN w:=0;h:=0 END;
IF (x+w)>(clip.x+clip.w) THEN w:=clip.x+clip.w-x END;
IF (y+h)>(clip.y+clip.h) THEN h:=clip.y+clip.h-y END;
IF (w<0) OR (h<0) THEN w:=0;h:=0 END;
END;
RETURN frame;
END ClipLongRect;
PROCEDURE ShortFrame (frame: GrafBase.LongRect): GrafBase.Rectangle;
(*$R-*)
VAR r: GrafBase.Rectangle;
BEGIN
r.x := SHORT (frame.x);
r.y := SHORT (frame.y);
r.w := SHORT (frame.w);
r.h := SHORT (frame.h);
RETURN r;
END ShortFrame;
(*$R=*)
(*-- drawing primitives ----------------------------------------------------*)
PROCEDURE Line (vdi: INTEGER; line : tLine; col, style: INTEGER);
BEGIN
(* Erstmal Linewidth setzen *)
v.int := MagicVDI.SetLinewidth (vdi, 1);
(* Linienstil setzen (geht nur bei Dicke 1, wird sonst ignoriert) *)
v.int := MagicVDI.SetLinetype (vdi, style);
IF (col > 1) & (mtAppl.Bitplanes = 1)
THEN
(* Statt Farbe machen wir die Linie dicker *)
v.int := MagicVDI.SetLinewidth (vdi, 2);
ELSE
(* Linienfarbe setzen *)
v.int := MagicVDI.SetLinecolor (vdi, col);
END;
MagicVDI.Polyline (vdi, 2, line);
END Line;
PROCEDURE Frame (vdi: INTEGER; col: INTEGER; x, y, w, h, times, style: INTEGER);
(* Zeichnet einen Rahmen, times bestimmt die Dicke
* Direkter VDI-Call, damit nicht ein temporres Linearray
* angelegt werden mu
*)
VAR i: INTEGER;
(*$Reg*) a: INTEGER;
b: INTEGER;
BEGIN
(* Erstmal Linewidth setzen *)
v.int := MagicVDI.SetLinewidth (vdi, 1);
(* Linienfarbe setzen *)
v.int := MagicVDI.SetLinecolor (vdi, col);
(* Linienstil setzen *)
v.int := MagicVDI.SetLinetype (vdi, style);
a:= 0; b:= 0;
DEC (x); DEC (y); INC (w, 2); INC (h, 2);
FOR i:= 1 TO times DO
DEC (x); DEC (y); INC (w, 2); INC (h, 2);
MagicVDI.VDIPtsIn[0 + a]:= x;
MagicVDI.VDIPtsIn[1 + a]:= y;
MagicVDI.VDIPtsIn[2 + a]:= x + w;
MagicVDI.VDIPtsIn[3 + a]:= y;
MagicVDI.VDIPtsIn[4 + a]:= MagicVDI.VDIPtsIn[2 + a]; (* x + w; *)
MagicVDI.VDIPtsIn[5 + a]:= y + h;
MagicVDI.VDIPtsIn[6 + a]:= x;
MagicVDI.VDIPtsIn[7 + a]:= MagicVDI.VDIPtsIn[5 + a]; (* y + h; *)
MagicVDI.VDIPtsIn[8 + a]:= x;
MagicVDI.VDIPtsIn[9 + a]:= y;
INC (a, 10); INC (b, 5);
END;
MagicVDI.VDICall(6, b, 0, 0, vdi);
END Frame;
PROCEDURE drawElement (ptr: treeWdwPtr; idx : CARDINAL; clip : GrafBase.Rectangle);
(* Diese Prozedur zeichnet ein Element oder seine Verbindungslinie,
* wenn es im Cliprechteck liegt
*)
VAR line : tLine;
lline: tLongLine;
fill : GrafBase.Rectangle;
lClip,
lfill,
frame: GrafBase.LongRect;
mess : data.MessageType;
text : CatTypes.String127;
base : GrafBase.LongPnt;
col,
style: INTEGER;
BEGIN
WITH ptr^ DO
WITH tree^[idx] DO
IF up < dataSys.notSaved
THEN
IF treeType = tVertical
THEN
(* Linie berechnen *)
lline.p1 := MidPointV (tree^[up].area, TRUE);
lline.p2 := MidPointV (area, FALSE);
ELSIF treeType = tHorizontal
THEN
lline.p1 := MidPointH (tree^[up].area, TRUE);
lline.p2 := MidPointH (area, FALSE);
END;
(* Jetzt Schnittpunkte berechnen *)
(* Aus der Linie auch noch kurz ein Rechteck machen *)
frame := GrafBase.LFramePoints (lline.p1, lline.p2);
(* Jetzt Gesamtbereich des Elements berechnen *)
lfill := area;
(* Rahmen ist um zwei Pixel auerhalb *)
DEC (lfill.x,2); DEC (lfill.y, 2);
INC (lfill.w,5); INC (lfill.h, 5);
frame := GrafBase.LFrameRects (lfill, frame);
ELSE
frame := area;
DEC (frame.x, 2);
DEC (frame.y, 2);
INC (frame.w, 5);
INC (frame.h, 5);
END;
(* Jetzt aus den relativen Koordinaten die absoluten berechnen *)
frame.x := frame.x - document.x + LONG(treeWork.x);
frame.y := frame.y - document.y + LONG(treeWork.y);
base.x := LONG(treeWork.x) - document.x;
base.y := LONG(treeWork.y) - document.y;
(*
frame := GrafBase.TransRect (frame, base);
*)
(* So, und jetzt nachsehen, ob davon ein Teil in der Cliparea ist *)
lClip := GrafBase.LongFrame (clip);
frame := GrafBase.LClipRect (frame, lClip);
IF (frame.w # 0) OR (frame.h # 0)
THEN
(* Ok, wir mssen zeichnen *)
col := CatGlobal.treeTextCol;
style := 1;
IF up < dataSys.notSaved THEN
INC (lline.p1.x, base.x);
INC (lline.p1.y, base.y);
INC (lline.p2.x, base.x);
INC (lline.p2.y, base.y);
(* Jetzt Koordinaten auf short wandeln *)
line.p1.x := SHORT(BinOps.LowerLInt (lline.p1.x, 32767));
line.p1.y := SHORT(BinOps.LowerLInt (lline.p1.y, 32767));
line.p2.x := SHORT(BinOps.LowerLInt (lline.p2.x, 32767));
line.p2.y := SHORT(BinOps.LowerLInt (lline.p2.y, 32767));
(* Linie noch etwas absetzen *)
IF treeType = tVertical
THEN
INC (line.p1.x, 3);
DEC (line.p2.x, 3);
ELSIF treeType = tHorizontal
THEN
INC (line.p1.y, 3);
DEC (line.p2.y, 3);
END;
(* Erstmal sehen, ob das Stichwort gendert wurde *)
IF ~Strings.StrEqual (betreff, tree^[up].betreff)
THEN
col := CatGlobal.treeLineCol;
IF mtAppl.Bitplanes = 1
THEN
style := MagicVDI.User;
END;
END;
Line (vdi, line, col, style);
END;
(* Jetzt das Element *)
(* Farbe setzen *)
v.int := MagicVDI.SetTextcolor (vdi, CatGlobal.treeTextCol);
(* Rahmen um Element zeichnen *)
lfill := area;
INC (lfill.x, base.x);
INC (lfill.y, base.y);
(* Jetzt daraus ein kleines Rechteck machen *)
fill := ShortFrame (lfill); (* Hier eigene Funktion einsetzen *)
Frame (vdi, col, fill.x, fill.y, fill.w, fill.h, 1, style);
IF zoomMode = zmNormal
THEN
(* Jetzt Text ausgeben *)
IF ~(dataSys.bGelesen IN flags)
THEN
IF mtAppl.Bitplanes = 1
THEN
(* Texteffect setzen *)
v.bset := MagicVDI.SetTexteffect (vdi, notReadEff);
ELSE
(* Farbe setzen *)
v.int := MagicVDI.SetTextcolor (vdi, CatGlobal.treeUnreadCol);
END;
ELSE
v.bset := MagicVDI.SetTexteffect (vdi, {});
END;
v.int := MagicVDI.SetWritemode (vdi, MagicVDI.TRANSPARENT);
VDIStandards.Text (isFSM, vdi, SHORT(base.x + area.x), SHORT(base.y + area.y) + charHeight-1, name);
VDIStandards.Text (isFSM, vdi, SHORT(base.x + area.x), SHORT(base.y + area.y) + 2*charHeight-1, betreff);
END;
(* Wenn es selektiert ist, dann invertieren wir es einfach *)
IF selected
THEN
(* Writemode auf XOR und area mit Schwarz fllen *)
v.int := MagicVDI.SetWritemode (vdi, MagicVDI.XOR);
v.int := MagicVDI.SetFillcolor (vdi, MagicAES.BLACK);
(* fill ist schon gesetzt, nur noch absolutes Rechteck daraus machen
*)
fill.w := fill.x + SHORT(area.w);
fill.h := fill.y + SHORT(area.h);
MagicVDI.FillRectangle (vdi, fill);
v.int := MagicVDI.SetFillcolor (vdi, CatGlobal.treeBackCol);
END;
v.int := MagicVDI.SetWritemode (vdi, MagicVDI.REPLACE);
IF ~(dataSys.bGelesen IN flags)
THEN
(* Texteffect und Farbe zurcksetzen *)
IF mtAppl.Bitplanes = 1
THEN
(* Texteffect setzen *)
v.bset := MagicVDI.SetTexteffect (vdi, {});
ELSE
(* Farbe setzen *)
v.int := MagicVDI.SetTextcolor (vdi, CatGlobal.treeTextCol);
END;
END;
END;
END;
END;
END drawElement;
PROCEDURE drawElemTree (ptr: treeWdwPtr; idx: CARDINAL; clip: GrafBase.Rectangle);
(* Rekursive Prozedur, die nur dazu da ist, den Baum zu durchlaufen
*)
BEGIN
WITH ptr^ DO
WHILE idx < dataSys.notSaved DO
drawElement (ptr, idx, clip);
IF tree^[idx].down < dataSys.notSaved
THEN
(* in die Tiefe gehen und die Teile zeichnen *)
drawElemTree (ptr, tree^[idx].down, clip);
END;
idx := tree^[idx].right;
END;
END;
END drawElemTree;
PROCEDURE drawTreeWdw (wdw, vdiH : INTEGER; special : ADDRESS; frame : GrafBase.Rectangle);
VAR ptr : treeWdwPtr;
clip,
fill: GrafBase.Rectangle;
BEGIN
ptr := treeWdwPtr (special);
WITH ptr^ DO
IF (mtAppl.Bitplanes = 1)
THEN
IF (CatGlobal.treeTextCol > 0)
THEN
CatGlobal.treeBackCol := 0;
ELSE
IF CatGlobal.treeBackCol = 0 THEN CatGlobal.treeBackCol := 1 END;
END;
CatGlobal.treeLineCol := CatGlobal.treeTextCol;
CASE CatGlobal.treeUnreadEff OF
0 : notReadEff := {}; |
1 : notReadEff := {MagicVDI.Fat}; |
2 : notReadEff := {MagicVDI.Italic}; |
3 : notReadEff := {MagicVDI.Light}; |
ELSE
notReadEff := {};
END;
ELSE
notReadEff := {};
END;
clip := frame;
IF RectFuncs.rcIntersect (treeWork, frame)
THEN
clip := RectFuncs.ClipRect (treeWork, frame);
INC (clip.w,2);
(* Jetzt den Hintergrund lschen *)
fill := clip;
fill.w := clip.x + clip.w - 1;
fill.h := clip.y + clip.h -1;
v.int := MagicVDI.SetFillcolor (vdi, CatGlobal.treeBackCol);
MagicVDI.FillRectangle(vdi, fill);
(* Und jetzt Elemente zeichnen *)
drawElemTree (ptr, 0, clip);
END;
END;
END drawTreeWdw;
PROCEDURE centerSelection (ptr : treeWdwPtr; redraw: BOOLEAN);
VAR i : CARDINAL;
lr : GrafBase.LongRect;
lt : GrafBase.LongRect;
lc : GrafBase.LongRect;
visible: BOOLEAN;
BEGIN
WITH ptr^ DO
i := 0;
WHILE (i < treeElems) & ~(tree^[i].selected) DO INC (i) END;
IF i < treeElems
THEN
(* Wir haben eine selektierte Nachricht *)
lr := tree^[i].area;
DEC (lr.x, 2);
DEC (lr.y, 2);
INC (lr.w, 5);
INC (lr.h, 5);
lt := GrafBase.LongFrame (treeWork);
lr.x := lr.x - document.x + lt.x;
lr.y := lr.y - document.y + lt.y;
(* Jetzt prfen, ob es sichtbar ist *)
lc := ClipLongRect (lr, lt);
visible := (lc.w # 0) & (lc.h # 0);
IF ~visible
THEN
(* document.x und .y umsetzen *)
lr := tree^[i].area;
document.x := BinOps.HigherLInt (lr.x - lt.w DIV 2, 0);
document.x := BinOps.HigherLInt (0, BinOps.LowerLInt (document.x, document.w - lt.w));
document.y := BinOps.HigherLInt (lr.y - lt.h DIV 2, 0);
document.y := BinOps.HigherLInt (0, BinOps.LowerLInt (document.y, document.h - lt.h));
IF redraw
THEN
(* WdwManager.FullRedrawWdw (wdw); *)
END;
END;
WdwManager.SetNewDocument (wdw, document, redraw);
END;
END;
END centerSelection;
PROCEDURE getEntryArea (ptr: treeWdwPtr; idx: CARDINAL; VAR r: GrafBase.Rectangle; VAR visible: BOOLEAN);
VAR lr : GrafBase.LongRect;
lt : GrafBase.LongRect;
lc : GrafBase.LongRect;
BEGIN
WITH ptr^ DO
lr := tree^[idx].area;
DEC (lr.x, 2);
DEC (lr.y, 2);
INC (lr.w, 5);
INC (lr.h, 5);
lt := GrafBase.LongFrame (treeWork);
lr.x := lr.x - document.x + lt.x;
lr.y := lr.y - document.y + lt.y;
(* Jetzt prfen, ob es sichtbar ist *)
lc := ClipLongRect (lr, lt);
visible := (lc.w # 0) & (lc.h # 0);
IF visible
THEN
r := ShortFrame (lr);
END;
END;
END getEntryArea;
PROCEDURE redrawEntry (ptr : treeWdwPtr; entry: CARDINAL);
(* Zeichnet einen Eintrag OHNE seine Linie neu *)
VAR rect : GrafBase.Rectangle;
vis : BOOLEAN;
BEGIN
WITH ptr^ DO
getEntryArea (ptr, entry, rect, vis);
IF vis
THEN
WdwManager.RedrawWdw (wdw, rect);
WdwManager.SetClip (vdi, treeWork, TRUE);
END;
END;
END redrawEntry;
PROCEDURE deselectEntries (ptr: treeWdwPtr);
VAR idx : CARDINAL;
clip,
r : GrafBase.Rectangle;
vis,
first: BOOLEAN;
BEGIN
WITH ptr^ DO
first := TRUE;
FOR idx := 0 TO treeElems - 1 DO
IF tree^[idx].selected
THEN
tree^[idx].selected := FALSE;
getEntryArea (ptr, idx, r, vis);
IF vis
THEN
IF first
THEN
clip := r;
first := FALSE;
ELSE
clip := GrafBase.FrameRects (clip, r);
END;
END;
END;
END;
IF ~first THEN WdwManager.RedrawWdw (wdw, clip); END;
END;
END deselectEntries;
PROCEDURE findEntry (ptr:treeWdwPtr; x, y: INTEGER; VAR idx: CARDINAL): BOOLEAN;
VAR i : CARDINAL;
r : GrafBase.Rectangle;
vis : BOOLEAN;
BEGIN
WITH ptr^ DO
FOR i := 0 TO treeElems - 1 DO
getEntryArea (ptr, i, r, vis);
IF vis & RectFuncs.IsInRect (x, y, r)
THEN
idx := i;
RETURN TRUE
END;
END;
END;
RETURN FALSE;
END findEntry;
PROCEDURE openSelected (ptr : treeWdwPtr; idx: CARDINAL; doNotTop, withCtrl: BOOLEAN);
VAR firstSel : CARDINAL;
isOpen : BOOLEAN;
window : INTEGER;
group,
mess : CARDINAL;
BEGIN
WITH ptr^ DO
IF (grinWindow >= 0)
THEN
isOpen := FALSE;
IF ~withCtrl &
grin.grinWindowTop (grinWindow) &
(grin.ActualGroupNr (grinWindow) = grHandle^.group)
THEN
isOpen := grin.grinSwitchTo (grinWindow, tree^[idx].msgNum, grin.grinNextMess, 0, doNotTop);
END;
IF ~isOpen
THEN
window := grin.grinOpenMessage (grHandle^.group, tree^[idx].msgNum, grin.grinNextMess, 0, grin.mOther);
(* Nun Anfragen, welches Grinfenster nun top ist *)
IF (window >= 0) & grin.grinWindowTop (window)
& grin.getBasicInfo (window, group, mess, v.lcard)
& (group = grHandle^.group) & (mess = tree^[idx].msgNum)
THEN
grinWindow := window;
ELSE
grinWindow := -1;
END;
END;
END;
END;
END openSelected;
PROCEDURE clickInTreeWindow(win, vdiH : INTEGER; special : ADDRESS; x,y : INTEGER; kstate : BITSET; buts: BITSET; clicks : INTEGER): BOOLEAN;
VAR transY : INTEGER;
ptr : treeWdwPtr;
entrySelected : BOOLEAN;
line : INTEGER;
but : BITSET;
isOpen : BOOLEAN;
ob : INTEGER;
clip : GrafBase.Rectangle;
kshift : BITSET;
p : GrafBase.Point;
idx : CARDINAL;
PROCEDURE selectArea;
VAR i : CARDINAL;
r : GrafBase.Rectangle;
rect : GrafBase.Rectangle;
first : BOOLEAN;
clip : GrafBase.Rectangle;
vis : BOOLEAN;
BEGIN
WITH ptr^ DO
rect := GrafBase.Rectangle{x, y, 0, 0};
mtAppl.MouseFinger ();
MagicAES.GrafRubberbox (x, y, -32767, -32767, rect.w, rect.h);
mtAppl.MouseArrow();
WITH rect DO
IF w < 0
THEN
INC(x, w);
w := -w
END;
IF h < 0
THEN
INC (y, h);
h := -h
END;
END;
(* clippen *)
rect := RectFuncs.ClipRect (rect, treeWork);
rect.h := BinOps.LowerInt (rect.h, treeWork.y + treeWork.h - 1 - rect.y);
first := TRUE;
FOR i := 0 TO treeElems - 1 DO
(* Jetzt prfen, ob das Element berhrt wird *)
getEntryArea (ptr, i, r, vis);
IF vis
THEN
IF RectFuncs.rcIntersect (rect, r)
THEN
(* Eintrag selektieren und zeichnen *)
tree^[i].selected := ~tree^[i].selected;
getEntryArea (ptr, i, r, vis);
IF vis
THEN
IF first
THEN
clip := r;
first := FALSE;
ELSE
clip := GrafBase.FrameRects (clip, r);
END;
END;
END;
END;
END;
IF ~first THEN WdwManager.RedrawWdw (wdw, clip); END;
END;
END selectArea;
BEGIN
ptr := treeWdwPtr (special);
WITH ptr^ DO
(*
(* Hier noch Baumposition anpassen *)
WdwManager.GetWdwWork (wdw, clip);
AdjustTreePos (clip, butWork);
IF RectFuncs.IsInRect (x, y, butWork)
THEN
(* Ist noch aus Stichwortliste, mu noch an Bume angepat werden
*)
ob := MagicAES.ObjcFind (butBox, 0, 8, x, y);
IF (ob >= MausTauschrsc.listsel) & (ob <= MausTauschrsc.listread)
THEN
RETURN handleButtons (ptr, ob, kstate);
END;
ELS
*)
IF RectFuncs.IsInRect (x, y, treeWork)
THEN
IF ~CatGlobal.WithShift (kstate)
THEN
(* Alte deselektieren *)
deselectEntries (ptr);
END;
(* Selektierten Eintrag finden *)
IF findEntry (ptr, x, y, idx)
THEN
(* Eintrag selektieren *)
tree^[idx].selected := ~tree^[idx].selected;
redrawEntry (ptr, idx);
(* Warten auf loslassen *)
REPEAT
MagicAES.GrafMkstate (x, y, but, v.bset);
UNTIL but={};
IF (clicks > 1) OR (~(0 IN buts) & (1 IN buts))
THEN
openSelected (ptr, idx, ~(0 IN buts) & (1 IN buts), CatGlobal.WithCtrl (kstate));
END;
ELSE
MagicAES.GrafMkstate (p.x, p.y, but, kstate);
IF 0 IN but
THEN
(* Graf-Rubberbox aufrufen *)
selectArea();
END;
END;
RETURN TRUE;
END;
END;
RETURN FALSE;
END clickInTreeWindow;
PROCEDURE handleTreeKey (wdw, vdiH : INTEGER; special : ADDRESS; taste: INTEGER; char, scan : CHAR; kstate : BITSET) : BOOLEAN;
VAR ptr : treeWdwPtr;
gemCh : CARDINAL;
key : MOSGlobals.Key;
ctrl : BOOLEAN;
shift : BOOLEAN;
done : BOOLEAN;
doc : GrafBase.LongRect;
firstSel : CARDINAL;
selChanged: BOOLEAN;
BEGIN
ptr := treeWdwPtr (special);
WITH ptr^ DO
gemCh := ORD(scan) * 256 + ORD(char);
Keyboard.GemCharToKey (gemCh, SHORT (INTEGER(kstate)), key);
ctrl := CatGlobal.WithCtrl (kstate);
shift := CatGlobal.WithShift (kstate);
done := TRUE;
IF Keyboard.IsSpecial (key)
THEN
CASE Keyboard.SpecialKey (key) OF
left : WdwManager.ScrollLeft (wdw, 1); |
soln : WdwManager.PageLeft (wdw); |
right : WdwManager.ScrollRight (wdw, 1); |
eoln : WdwManager.PageRight (wdw); |
up : WdwManager.ScrollUp (wdw, 1); |
down : WdwManager.ScrollDown (wdw, 1); |
pgUp : WdwManager.PageUp (wdw); |
pgDown : WdwManager.PageDown (wdw); |
altC : document.x := 0;
document.y := 0;
IF treeType = tVertical
THEN
treeType := tHorizontal;
ELSE
treeType := tVertical;
END;
iTreeSetFont (wdw, font, fontSize, FALSE);
centerSelection (ptr, TRUE); |
altZ : document.x := 0;
document.y := 0;
IF zoomMode = zmNormal
THEN
zoomMode := zmZoom;
ELSE
zoomMode := zmNormal;
END;
iTreeSetFont (wdw, font, fontSize, FALSE);
centerSelection (ptr, TRUE); |
ELSE
done := FALSE
END;
ELSE
done := FALSE;
END;
RETURN done;
END;
RETURN FALSE
END handleTreeKey;
PROCEDURE handleTreeTimer (wdw, vdiH : INTEGER; special : ADDRESS): BOOLEAN;
BEGIN
RETURN FALSE
END handleTreeTimer;
PROCEDURE closeTreeWindow (wdw, vdiH : INTEGER; special : ADDRESS; force : BOOLEAN) : BOOLEAN;
VAR ptr : treeWdwPtr;
varName : CatTypes.String255;
full : GrafBase.Rectangle;
BEGIN
ptr := treeWdwPtr (special);
WITH ptr^ DO
Strings.Concat (cTreeWdw, StrConv.IntToStr (number, 0), varName, v.bool);
WdwManager.GetWdwSize (wdw, full); (* Gre des Fensters abfragen *)
v.bool := ConfVars.SetConfigRect (varName, full);
Strings.Concat (cTreeFont, StrConv.IntToStr (number, 0), varName, v.bool);
v.bool := ConfVars.SetConfigInt (varName, font);
Strings.Concat (cTreeSize, StrConv.IntToStr (number, 0), varName, v.bool);
v.bool := ConfVars.SetConfigInt (varName, fontSize);
ClearNum (number);
FontSelect.UnloadFonts (vdi);
END;
(* Speicher freigeben *)
DEALLOCATE (ptr^.tree, 0);
freeOffset (ptr^.horizontal);
freeOffset (ptr^.vertical);
handlePool.FreeOneDataHandle(ptr^.grHandle);
handlePool.FreeOnePtr(ptr, windows);
RETURN TRUE
END closeTreeWindow;
PROCEDURE topTreeWdw (wdw, vdiH : INTEGER; special : ADDRESS) : BOOLEAN;
BEGIN
RETURN TRUE;
END topTreeWdw;
PROCEDURE untopTreeWdw (wdw, vdiH : INTEGER; special : ADDRESS);
END untopTreeWdw;
PROCEDURE updateTreeWdw (wdw, vdiH : INTEGER; special : ADDRESS; update : BOOLEAN);
BEGIN
IF update
THEN
MagicAES.WindUpdate (MagicAES.BEGUPDATE);
mtAppl.MouseOff();
ELSE
mtAppl.MouseOn();
MagicAES.WindUpdate (MagicAES.ENDUPDATE);
END;
END updateTreeWdw;
PROCEDURE hideTreeWdw (wdw, vdiH : INTEGER; special : ADDRESS; hide : BOOLEAN);
VAR ptr : treeWdwPtr;
BEGIN
END hideTreeWdw;
PROCEDURE setTreeWork (wdw, vdiH : INTEGER; special : ADDRESS; doc : GrafBase.LongRect; slided : BOOLEAN);
VAR ptr : treeWdwPtr;
BEGIN
ptr := treeWdwPtr (special);
WITH ptr^ DO
document := doc;
END;
END setTreeWork;
PROCEDURE snapTreeWdw (wdw, vdiH : INTEGER; special : ADDRESS; VAR work : GrafBase.Rectangle);
CONST minWindWidth = 128;
minWindHeight = 128;
VAR ptr : treeWdwPtr;
BEGIN
ptr := treeWdwPtr (special);
WITH ptr^ DO
IF font >= 0
THEN
WITH work DO
treeWork := work;
WdwManager.SetScrollParms (wdw, w-charWidth, h-charHeight, charWidth, charHeight);
END;
END;
END;
END snapTreeWdw;
PROCEDURE getTreeScroll (wdw, vdiH : INTEGER; special : ADDRESS; VAR work : GrafBase.Rectangle);
VAR ptr : treeWdwPtr;
varName : ARRAY [0..255] OF CHAR;
full : GrafBase.Rectangle;
BEGIN
ptr := treeWdwPtr (special);
WITH work DO
WdwManager.SetScrollParms (wdw, w-ptr^.charWidth, h - ptr^.charHeight, ptr^.charWidth, ptr^.charHeight);
ptr^.treeWork := work;
END;
WITH ptr^ DO
IF wdw >= 0
THEN
Strings.Concat (cTreeWdw, StrConv.IntToStr (number, 0), varName, v.bool);
WdwManager.GetWdwSize (wdw, full); (* Gre des Fensters abfragen *)
v.bool := ConfVars.SetConfigRect (varName, full);
END;
END;
END getTreeScroll;
PROCEDURE MakeTitle (gruppe: CARDINAL; VAR title: ARRAY OF CHAR);
BEGIN
GroupSelect.GroupName (gruppe, title);
ConfVars.GetConfDefBool (cSetAppName, v.bool, TRUE);
IF CatGlobal.multiTask & v.bool
THEN
MagicStrings.Insert ('[CAT] ', title, 0);
END;
MagicStrings.Insert (' ', title, 0);
MagicStrings.Append (' ', title);
END MakeTitle;
VAR treeCounter : CARDINAL;
globalTree : treeArrayPtr;
PROCEDURE treeCount (hdl: data.OneGroupHandle; msgIdx: CARDINAL; mess: dataSys.pBlockPtr);
BEGIN
INC (treeCounter);
END treeCount;
PROCEDURE treeBuild (hdl: data.OneGroupHandle; msgIdx: CARDINAL; msg: dataSys.pBlockPtr);
VAR tmpStr: CatTypes.String255;
line : tShortText;
mess : data.MessageType;
maxLen: CARDINAL;
i : CARDINAL;
p, n : INTEGER;
PROCEDURE CheckAssign (strPtr: CatTypes.Str255Ptr; VAR str : ARRAY OF CHAR);
BEGIN
IF strPtr # NIL
THEN
Strings.Assign (strPtr^, str, v.bool);
ELSE
Strings.Assign ("", str, v.bool);
END;
END CheckAssign;
BEGIN
WITH globalTree^[treeCounter] DO
msgNum := msgIdx;
selected := FALSE;
(* Erstmal die Messagenummern eintragen *)
up := msg^.upMess;
down := msg^.downMess;
right := msg^.rightMess;
left := msg^.leftMess;
(* Jetzt die Daten lesen *)
data.ReadHeader (hdl, msgIdx, mess);
IF data.error = data.noError
THEN
(* Flags zuweisen *)
flags := mess.StatusBits;
(* Jetzt die Texte *)
IF mess.EigeneNachricht & (mess.Gruppe = dataSys.private)
THEN
Strings.Assign ('An: ', line, v.bool);
CheckAssign (mess.Empfaenger, tmpStr);
maxLen := SIZE (line)- 5;
ELSE
CheckAssign (mess.Absender, tmpStr);
line[0]:= '';
maxLen := SIZE (line)-1;
END;
CatGlobal.KurzName (tmpStr, tmpStr, maxLen);
(*
IF LENGTH (tmpStr) > maxLen
THEN
(* Erstmal Vornamen abkrzen *)
p := 0;
p := Strings.Pos (' ', tmpStr, 0);
IF p > 0
THEN
n := Strings.Pos ('@', tmpStr, 0);
IF (n > 0) & (n-2 < p)
THEN
(* Hinter dem @ abschneiden, da kein richtiger Vorname *)
tmpStr [n] := 0C;
ELSE
(* Vornamen verkrzen *)
Strings.Delete (tmpStr, 1, p-1, v.bool);
Strings.Insert ('.', 1, tmpStr, v.bool);
END;
END;
END;
IF LENGTH (tmpStr) > maxLen
THEN
(* Eventuell Adresse abschneiden *)
n := Strings.Pos ('@', tmpStr, 0);
IF (n >= 0)
THEN
(* Ab dem @ abschneiden *)
tmpStr [n] := 0C;
END;
END;
IF LENGTH (tmpStr) > maxLen
THEN
(* Zu lang, hinten Pfeil nach rechts anhngen *)
tmpStr[maxLen-1] := 3C;
tmpStr[maxLen] := 0C;
END;
*)
Strings.Append (tmpStr, line, v.bool);
Strings.Assign (line, name, v.bool);
width := LENGTH (name);
(* Jetzt noch das Stichwort *)
CheckAssign (mess.Betreff, tmpStr);
maxLen := SIZE (line) - 1;
IF LENGTH (tmpStr) > maxLen
THEN
(* Zu lang, hinten Pfeil nach rechts anhngen *)
tmpStr[maxLen-1] := 3C;
tmpStr[maxLen] := 0C;
END;
width := BinOps.HigherInt (LENGTH (tmpStr), width);
Strings.Assign (tmpStr, betreff, v.bool);
(* Speicher wieder freigeben *)
DEALLOCATE (mess.InfoStrings, 0);
END; (* IF data.error *)
END;
INC (treeCounter);
END treeBuild;
PROCEDURE getTreeDepth (tree: treeArrayPtr; idx: CARDINAL; depth: CARDINAL; VAR maxDepth: CARDINAL);
VAR i : CARDINAL;
BEGIN
INC (depth);
IF depth > maxDepth THEN maxDepth := depth END;
i := idx;
WHILE i < dataSys.notSaved DO
IF tree^[i].down < dataSys.notSaved THEN
getTreeDepth (tree, tree^[i].down, depth, maxDepth);
END;
i := tree^[i].right;
END;
DEC (depth);
END getTreeDepth;
PROCEDURE findMsgIdx (ptr: treeWdwPtr; VAR idx: CARDINAL);
VAR i : CARDINAL;
BEGIN
WITH ptr^ DO
FOR i := 0 TO treeCounter - 1 DO
IF tree^[i].msgNum = idx
THEN
idx := i;
RETURN
END;
END; (* for *)
END;
END findMsgIdx;
PROCEDURE buildTree (ptr : treeWdwPtr; handle: handlePool.oneHandlePtr; msg: CARDINAL): BOOLEAN;
VAR mess : data.MessageType;
place: GrafBase.Rectangle;
i, j : CARDINAL;
mem : LONGCARD;
BEGIN
WITH ptr^ DO
(* Erstmal Speicher fr die Offsetarray allozieren *)
vertical := createOffset (128);
IF vertical = NIL THEN RETURN FALSE END;
horizontal := createOffset (128);
IF horizontal = NIL THEN freeOffset (vertical); RETURN FALSE END;
(* Konfigvariablen auslesen *)
ConfVars.GetConfDefInt (cTreeUpLevels, maxUpLevels, 20);
ConfVars.GetConfDefInt (cTreeMaxDepth, maxTreeDepth, 40);
(* Objekte im Baum zhlen *)
treeCounter := 0;
(*
data.WalkTree (handle^.Zugriff, msg, TRUE, treeCount);
*)
data.WalkTree2 (handle^.Zugriff, msg, maxUpLevels, maxTreeDepth, treeCount);
(* Jetzt Speicher allozieren *)
treeElems := treeCounter;
mem := LONG (treeCounter) * TSIZE (treeElem);
ALLOCATE (tree, mem);
IF tree = NIL THEN
freeOffset (horizontal);
freeOffset (vertical);
RETURN FALSE
END;
(* Speicher lschen, damit die Strings nicht einzeln gelscht werden
* mssen
*)
Block.Clear (tree, mem);
(* Speicher ist da, jetzt Baum aufbauen. Dabei mu ich danach die Indizes
* nochmal umrechnen! *)
treeCounter := 0;
globalTree := tree;
(*
data.WalkTree (handle^.Zugriff, msg, TRUE, treeBuild);
*)
data.WalkTree2 (handle^.Zugriff, msg, maxUpLevels, maxTreeDepth, treeBuild);
(* Wir haben jetzt einen Baum. Jetzt mssen wir die Indizes noch anpassen,
* daher gebe ich die jetzt erstmal aus.
*)
(* so, jetzt mssen wir die Indizes noch anpassen *)
FOR i := 0 TO treeCounter - 1 DO
findMsgIdx (ptr, tree^[i].up);
findMsgIdx (ptr, tree^[i].down);
findMsgIdx (ptr, tree^[i].right);
findMsgIdx (ptr, tree^[i].left);
END;
(* Jetzt mssen noch alle Treeindizes, die nicht im erlaubten Bereich
* liegen (0..treeElems-1) auf empty gesetzt werden, da ja nur ein
* Teilbaum vorhanden ist
*)
FOR i := 0 TO treeCounter - 1 DO
IF tree^[i].up >= treeCounter THEN tree^[i].up := dataSys.empty END;
IF tree^[i].down >= treeCounter THEN tree^[i].down := dataSys.empty END;
IF tree^[i].left >= treeCounter THEN tree^[i].left := dataSys.empty END;
IF tree^[i].right >= treeCounter THEN tree^[i].right := dataSys.empty END;
IF tree^[i].msgNum = msg THEN tree^[i].selected := TRUE END;
END;
RETURN TRUE;
END;
END buildTree;
PROCEDURE treeOpen (gruppe, which : CARDINAL; grinWdw : INTEGER);
VAR ptr : treeWdwPtr;
handlePtr : handlePool.oneHandlePtr;
varName : ARRAY[0..39] OF CHAR;
work : GrafBase.Rectangle;
comps : BITSET;
i : CARDINAL;
num : INTEGER;
infoLine : CatTypes.String127;
BEGIN
IF which >= dataSys.notSaved THEN RETURN END;
IF handlePool.BlankToList(ptr, TSIZE(treeWindow), windows)
THEN
IF handlePool.GetOneDatahandle(gruppe, handlePtr)
THEN
ptr^.wdw := -1;
ptr^.grHandle := handlePtr;
ptr^.grinWindow := grinWdw;
(* Fensternummer dieses Moduls herausfinden *)
ptr^.number := FindNum ();
Strings.Concat (cTreeWdw, StrConv.IntToStr (ptr^.number, 0), varName,
v.bool);
IF ~ConfVars.GetConfigRect (varName, ptr^.treeWork)
THEN
IF (ptr^.number > 0)
THEN
num := ptr^.number - 1;
Strings.Concat (cTreeWdw, StrConv.IntToStr (num, 0), varName,
v.bool);
END;
ConfVars.GetConfDefRect (varName, ptr^.treeWork, EditTypes.deskSize);
IF ~ RectFuncs.RectEqual (ptr^.treeWork, EditTypes.deskSize)
THEN
INC (ptr^.treeWork.x, 2*mtAppl.CharWidth);
INC (ptr^.treeWork.y, mtAppl.CharHeight);
END;
Strings.Concat (cTreeWdw, StrConv.IntToStr (ptr^.number, 0), varName, v.bool);
v.bool := ConfVars.SetConfigRect (varName, ptr^.treeWork);
END;
(* Fensterkomponenten setzen *)
comps := {MagicAES.NAME..MagicAES.HSLIDE};
MakeTitle (gruppe, ptr^.grName);
IF data.LastMsgOfGroup (gruppe) = dataSys.empty
THEN
(* Gruppe ist leer! *)
handlePool.FreeOneDataHandle(handlePtr);
handlePool.FreeOnePtr (ptr, windows);
ClearNum (ptr^.number);
RETURN
END;
(* Jetzt den Baum aufbauen *)
IF ~buildTree (ptr, handlePtr, which)
THEN
MTE.noMemAlert();
RETURN
END;
(* Infozeile basteln *)
MagicStrings.Assign (' ', infoLine);
MagicStrings.Append (StrConv.CardToStr (ptr^.treeElems, 0), infoLine);
MagicStrings.Append (' Nachricht', infoLine);
IF ptr^.treeElems > 1 THEN
MagicStrings.Append ('en', infoLine);
END;
MagicStrings.Append (' in diesem Baum', infoLine);
(* Fenster ffnen *)
IF WdwManager.OpenWindow (clickInTreeWindow, handleTreeKey, handleTreeTimer,
EditTypes.deskSize, ptr^.treeWork, comps, TRUE,
infoLine, ptr^.grName, snapTreeWdw, closeTreeWindow,
drawTreeWdw, topTreeWdw, untopTreeWdw, updateTreeWdw,
setTreeWork, getTreeScroll, hideTreeWdw,
0, ptr, FALSE, TRUE, TRUE, TRUE,
ptr^.wdw, ptr^.vdi)
THEN
WITH ptr^ DO
(* Font aus Configvariablen lesen und setzen *)
Strings.Concat (cTreeFont, StrConv.IntToStr (number, 0), varName, v.bool);
IF ~ConfVars.GetConfigInt (varName, font)
THEN
num := BinOps.HigherInt (number-1, 0);
Strings.Concat (cTreeFont, StrConv.IntToStr (num, 0), varName, v.bool);
ConfVars.GetConfDefInt (varName, font, 1);
Strings.Concat (cTreeSize, StrConv.IntToStr (num, 0), varName,
v.bool);
ConfVars.GetConfDefInt (varName, fontSize, 10);
Strings.Concat (cTreeFont, StrConv.IntToStr (number, 0), varName, v.bool);
v.bool := ConfVars.SetConfigInt (varName, font);
Strings.Concat (cTreeSize, StrConv.IntToStr (number, 0), varName, v.bool);
v.bool := ConfVars.SetConfigInt (varName, fontSize);
ELSE
Strings.Concat (cTreeSize, StrConv.IntToStr (number, 0), varName, v.bool);
ConfVars.GetConfDefInt (varName, fontSize, 10);
END;
(* Typ festlegen *)
treeType := tVertical;
zoomMode := zmNormal;
(* Noch ein bichen was fr die Window-Library *)
WdwManager.SetNewDocument (wdw, document, FALSE);
(* Fonts laden *)
FontSelect.LoadFonts (vdi, v.int);
(* Font setzen *)
document.x := 0;
document.y := 0;
iTreeSetFont (wdw, font, fontSize, FALSE);
(* Jetzt noch ein paar andere VDI-Variablen setzen *)
v.int := MagicVDI.SetFillstyle (vdi, MagicVDI.Full);
v.int := MagicVDI.SetFillinterior (vdi, MagicVDI.Full);
v.int := MagicVDI.SetFillcolor (vdi, CatGlobal.treeBackCol);
MagicVDI.SetUserlinestyle (vdi, $F0F0);
(* Schreibmodus setzen *)
v.int := MagicVDI.SetWritemode (vdi, MagicVDI.REPLACE);
(* Und jetzt noch die erste selektierte Nachricht zentrieren
*)
centerSelection (ptr, FALSE);
END (* WITH *);
ELSE
(* Fenster konnte nicht geffnet werden *)
DEALLOCATE (ptr^.tree, 0); (* Speicher freigeben *)
v.int := mtAlerts.Alert (1,MTE.noWinOrWork);
END (* IF openWindow *);
ELSE
(* Gruppe konnte nicht geffnet werden *)
handlePool.FreeOnePtr (ptr, windows);
MTE.noMemAlert();
END;
ELSE
(* Kein Platz mehr fr Fenstereintrag *)
MTE.noMemAlert();
END;
END treeOpen;
PROCEDURE treeClose (wdw : INTEGER);
(* Ein Baumfenster wird geschlossen *)
VAR p : treeWdwPtr;
BEGIN
IF handlePool.FindEntry(ADR(wdw), FindWinCond, windows, p) THEN
v.bool := WdwManager.CloseWindow (wdw, TRUE);
END;
END treeClose;
PROCEDURE treeCloseAll ();
(* Schliet alle Fenster des Moduls
*)
(* Alle Sichwortlistenfenster werden geschlossen *)
VAR lauf : treeWdwPtr;
BEGIN
Lists.ResetList(windows);
lauf := Lists.NextEntry(windows);
WHILE lauf # NIL DO
treeClose(lauf^.wdw);
lauf := Lists.NextEntry(windows);
END;
END treeCloseAll;
PROCEDURE treeWindowTop (wdw : INTEGER) : BOOLEAN;
(* Ist ein Kommentarbaumfenster oben? *)
BEGIN
RETURN handlePool.FindEntry(ADR(wdw), FindWinCond, windows, v.a);
END treeWindowTop;
PROCEDURE treeSetFont (wdw: INTEGER; font, fontSize : INTEGER);
(* Setzt den Font fr das Kommentarbaumfenster *)
BEGIN
iTreeSetFont (wdw, font, fontSize, TRUE);
END treeSetFont;
PROCEDURE treeSetFlags(wdw : INTEGER; setBits, clearBits : BITSET);
(* Fr alle selektierten Nachrichten
* ein paar Flags setzen oder lschen
*)
VAR p : treeWdwPtr;
bits,
newBits : BITSET;
i : CARDINAL;
(*$Reg*) counter : CARDINAL;
vis : BOOLEAN;
first : BOOLEAN;
r,
clip : GrafBase.Rectangle;
BEGIN
IF handlePool.FindEntry(ADR(wdw), FindWinCond, windows, p) THEN
WITH p^ DO
CatGlobal.busyMouse();
counter := 0;
first := TRUE;
FOR i := 0 TO treeElems-1 DO
IF tree^[i].selected THEN
data.ReadState (grHandle^.Zugriff, tree^[i].msgNum, bits);
IF data.error = data.noError
THEN
(* Neue Flags berechnen *)
newBits := (bits-clearBits)+setBits;
(* Flags setzen *)
data.SetBits(grHandle^.Zugriff, tree^[i].msgNum, newBits);
IF newBits # tree^[i].flags
THEN
tree^[i].flags := newBits;
getEntryArea (p, i, r, vis);
IF vis
THEN
IF first
THEN
clip := r;
first := FALSE;
ELSE
clip := GrafBase.FrameRects (clip, r);
END;
END;
END;
INC (counter);
IF counter MOD 50 = 0 THEN CatGlobal.busyMouse(); END;
END;
END;
END;
mtAppl.MouseArrow();
END;
IF ~first THEN WdwManager.RedrawWdw (wdw, clip); END;
END;
END treeSetFlags;
PROCEDURE treeSelectAll(wdw : INTEGER);
(* Alle Nachrichten in dem Fenster werden selektiert
*)
VAR ptr : treeWdwPtr;
idx : CARDINAL;
(*$Reg*) counter : CARDINAL;
first : BOOLEAN;
r,
clip : GrafBase.Rectangle;
vis : BOOLEAN;
BEGIN
IF handlePool.FindEntry(ADR(wdw), FindWinCond, windows, ptr) THEN
WITH ptr^ DO
first := TRUE;
FOR idx := 0 TO treeElems - 1 DO
IF ~tree^[idx].selected
THEN
tree^[idx].selected := TRUE;
getEntryArea (ptr, idx, r, vis);
IF vis
THEN
IF first
THEN
clip := r;
first := FALSE;
ELSE
clip := GrafBase.FrameRects (clip, r);
END;
END;
END;
END;
IF ~first THEN WdwManager.RedrawWdw (wdw, clip); END;
END;
END;
END treeSelectAll;
BEGIN
Lists.CreateList (windows, v.bool);
(*
CatGlobal.treeBackCol := 0;
CatGlobal.treeTextCol := 1;
CatGlobal.treeLineCol := 1;
*)
maxUpLevels := 20; (* Spter durch Configvariablen auslesen *)
maxTreeDepth := 40; (* " *)
END treeList.